home *** CD-ROM | disk | FTP | other *** search
/ Technotools / Technotools (Chestnut CD-ROM)(1993).ISO / lang_bas / qbscrgen / sgdemo.bas next >
BASIC Source File  |  1987-07-24  |  26KB  |  919 lines
  1. rem $linesize:132
  2. rem $title:'* Screen I/O Generator *'
  3. rem $subtitle:'* Introduction *'
  4. rem $include:'aecommon.bas'
  5. '
  6. '              SGDEMO
  7. '
  8. '     (c) Roy Barrow, 1986,1987.
  9. '
  10.     dim fl$(255%),dl.2$(4%)                   ' File array, 2nd Key Select Array
  11.     dim text$(24%),datfrm$(3%)                ' Lines 2-24
  12.     dim ip.frame%(24%,80%)                    ' Frame for input markers
  13.     dim var.type$(6%)                         ' Variable types
  14.     dim io.name$(100%)                        ' 100 Names for Input Definition
  15.     dim io.x%(100%)                           ' 100 X Locations
  16.     dim io.y%(100%)                           ' 100 Y Locations
  17.     dim mrec%(100%)                           ' 100 Master Pointers
  18.     dim basgen$(100%)                         ' Basic Generation Sequence Array
  19.     def fnn$(a%)=mid$(str$(a%),2%)            ' Commonly used STRIPPER
  20.  
  21.     data "Single String","Text Block","Date"
  22.     data "Integer","Single Precision","Double Precision"
  23.     data "mm/dd/yy","yy/mm/dd","dd/mm/yy"
  24.     for j%=1% to 6%
  25.         read var.type$(j%)
  26.     next j%
  27.     for j%=1% to 3%
  28.         read datfrm$(j%)
  29.     next j%
  30.  
  31.     call color.init("appcolor.ctl")
  32.  
  33. menu1:
  34.     data 6,"File","Edit","Draw","Input","Exit","Color Setup"
  35.     data 7,"Load","Save","Merge","","Generate Basic","","Status"
  36.     data 9,"Copy of above line","Center Line","Insert Blank Line","Delete Line","Insert Column","Delete Column","Find & Replace","","Clear"
  37.     data 3,"Box","Vertical Line","Horizontal Line"
  38.     data 4,"Definition","","Remove","Clear"
  39.     data 3,"To Editor (ESC)","To Shell","To System"
  40.     data 1,"Define Attributes"
  41.     restore menu1
  42.     gosub get.menu
  43.  
  44. '
  45. '  The menu definition is now made. Now call the Introductory box
  46. '
  47.     locate ,,0
  48.     call qbtools.frame
  49.     w$=input$(1%)
  50.     cls
  51.  
  52.     ae.sstack%=2000%
  53.     call Centre.Text("Screen Generator Version: SGDEMO v 1.02",1%)
  54.     call startup
  55.  
  56.     for j%=1% to 24%
  57.         text$(j%)=string$(80%,32%)
  58.         for k%=1% to 80%
  59.             ip.frame%(j%,k%)=0%
  60.         next k%
  61.     next j%
  62.  
  63.     for j%=1% to 100%
  64.         io.name$(j%)=""
  65.         io.x%(j%)=0%
  66.         io.y%(j%)=0%
  67.         mrec%(j%)=0%
  68.     next j%
  69.  
  70.     call scroll(1,2,80,24,0)
  71.     ins$="Off"
  72.     x%=1%
  73.     y%=2%
  74.     xmin%=1%
  75.     xmax%=80%
  76.     ymin%=2%
  77.     ymax%=24%
  78.     cycle%=0%
  79.     lsch%=32%                      ' Last special alternate character
  80.     dr.only%=0%                    ' Currently in NODRAW mode
  81.     while cycle%=0%
  82.  
  83.         if ip.frame%(y%,x%) then
  84.             i.o.txt$="F5=I/O "
  85.             i.o.set%=1%
  86.         else
  87.             i.o.txt$="         "
  88.             i.o.set%=0%
  89.         end if
  90.  
  91.         if dr.only%=1% then
  92.             i.o.txt$="Draw:"
  93.             if vl.draw%=1% then
  94.                 i.o.txt$=i.o.txt$+"Vl"
  95.             end if
  96.             if hz.draw%=1% then
  97.                 i.o.txt$=i.o.txt$+"Hl"
  98.             end if
  99.             if bx.draw%=1% then
  100.                 i.o.txt$=i.o.txt$+"Box"
  101.             end if
  102.         end if
  103.  
  104.         optex$="F1=Menu  F2=Last Menu  F3=Alt Ch  F4=Last Alt Ch  Ins="+ins$+"  x="+fnn$(x%)+"  y="+fnn$(y%)+"  "+i.o.txt$
  105.         call qprint(optex$,25,1)
  106.         locate y%,x%,1%,0%,15%                             ' Display the cursor
  107.         call Get.Single(ch%,ctype%)
  108.  
  109.         if dr.only%=0% then
  110.             if ctype%=2% then
  111.                 if ch%=61% then
  112.                     for j%=1% to 70%
  113.                         fl$(j%)=chr$(j%+173%)
  114.                     next j%
  115.                     dialog$(1)="Select a"
  116.                     dialog$(2)="Character"
  117.                     dialog$(3)="From List"
  118.                     dialog$(4)=""
  119.                     call select.box(fl$(),8%,70%,1%,opt$)
  120.                     ch%=asc(opt$)
  121.                     lsch%=ch%
  122.                     ctype%=1%
  123.                 end if
  124.             end if
  125.  
  126.             if ctype%=2% then                ' Repeat last Alternate Character
  127.                 if ch%=62% then
  128.                     ch%=lsch%
  129.                     ctype%=1%
  130.                 end if
  131.             end if
  132.  
  133.             if ctype%=2% then
  134.                 if ch%=63% then               ' Display i.o.definition
  135.                     if i.o.set% then
  136.                         nav%=ip.frame%(y%,x%)
  137.                         rec%=mrec%(nav%)
  138.                         get #11,rec%
  139.                         vt%=asc(v.type$)
  140.                         varn$=var.des$
  141.                         call ctrl.trim(varn$)
  142.                         dialog$(1%)="Variable: "+varn$+" ("+var.type$(vt%)+")"
  143.                         if vt%=1% then
  144.                             dialog$(2%)=str$(asc(s.len$))+" characters in length."
  145.                         end if
  146.                         if vt%=2% then
  147.                             dialog$(2%)=str$(asc(b.width$))+" characters wide, and"+str$(asc(b.height$))+" lines high."
  148.                         end if
  149.                         if vt%=3% then
  150.                             dialog$(2%)="Which is in the format:"
  151.                             df%=asc(d.form$)
  152.                             dialog$(2%)=dialog$(2%)+datfrm$(df%)+"."
  153.                         end if
  154.                         if (vt%=4% or vt%=6% or vt%=5%) then
  155.                             dialog$(2%)="In value between"
  156.                             dialog$(2%)=dialog$(2%)+str$(cvd(v.min$))+" and"+str$(cvd(v.max$))+"."
  157.                         end if
  158.                         dc%=2%
  159.                         call Press.Any.Key(dc%)
  160.                     end if
  161.                 end if
  162.             end if
  163.  
  164.             if ctype%=2% then
  165.                 if ch%=59% or ch%=60% then
  166.                     if ch%=59% then
  167.                         where%=varptr(ae.screens%(1%))
  168.                         locate ,,0
  169.                         restore menu1
  170.                         gosub get.menu
  171.                         call Pull.Down.Menu
  172.                         prvmen%=menu%
  173.                         prvop%=menop%
  174.                     end if
  175.                     if ch%=60% then
  176.                         menu%=prvmen%
  177.                         menop%=prvop%
  178.                     end if
  179.                     if menu%=1% then
  180.  
  181. rem $subtitle:'Load an existing file.'
  182. rem $page
  183.                         if menop%=1% then       ' Load a file
  184.                             call getfiles(fl$(),"?","scr",count%)
  185.                             if count%>0% then
  186.                                 call qsort(fl$(),count%)
  187.                                 dialog$(1)="Select file to load"
  188.                                 dialog$(2)="from the list on the"
  189.                                 dialog$(3)="left."
  190.                                 dialog$(4)=""
  191.                                 call select.box(fl$(),10%,count%,12%,opt$)
  192.                                 call ctrl.trim(opt$)
  193.                                 if len(opt$) then
  194.                                     open "r",1,opt$,80
  195.                                     opt$=left$(opt$,instr(opt$,".")-1%)
  196.                                     field #1,80 as s1$
  197.                                     for j%=1% to 24%
  198.                                         get #1,j%
  199.                                         text$(j%)=s1$
  200.                                     next j%
  201.                                     close 1
  202.                                     for j%=2% to 24%
  203.                                         call qprint(text$(j%),j%,1%)
  204.                                     next j%
  205.                                 end if
  206.                             end if
  207.                             if count%=0% then      ' No file exists.
  208.                             end if
  209.                         end if
  210.  
  211. rem $subtitle:'Save a file.'
  212. rem $page
  213.                         if menop%=2% then       ' Save a file
  214.                             dialog$(1)="Save this file as ..."
  215.                             dialog$(2)=""
  216.                             fil.1$=string$(8%,32%)
  217.                             l1%=8%
  218.                             call Dialog(fil.1$,l1%)
  219.                             call ctrl.trim(fil.1$)
  220.                             if len(fil.1$) then
  221.                                 open "r",1,fil.1$+".SCR",80
  222.                                 field #1,80 as s1$
  223.                                 for j%=1% to 24%
  224.                                     lset s1$=text$(j%)
  225.                                     put #1,j%
  226.                                 next j%
  227.                                 close 1
  228.  
  229.                             end if
  230.                         end if
  231.  
  232. rem $subtitle:'Merge a file.'
  233. rem $page
  234.                         if menop%=3% then       ' Merge a file
  235.                             call getfiles(fl$(),"?","scr",count%)
  236.                             if count% then
  237.                                 call qsort(fl$(),count%)
  238.                             end if
  239.                             if count% then
  240.                                 dialog$(1)="Select file to merge from"
  241.                                 dialog$(2)="the list on the left. This"
  242.                                 dialog$(3)="option merges in screen"
  243.                                 dialog$(4)="text only. I/O is ignored."
  244.                                 call select.box(fl$(),10%,count%,12%,opt$)
  245.                                 call ctrl.trim(opt$)
  246.                                 if len(opt$) then
  247.                                     open "r",1,opt$,80
  248.                                     opt$=left$(opt$,instr(opt$,".")-1%)
  249.                                     field #1,80 as s1$
  250.                                     for j%=2% to 24%
  251.                                         get #1,j%
  252.                                         for k%=1% to 80%
  253.                                             if mid$(text$(j%),k%,1%)=" " then
  254.                                                 mid$(text$(j%),k%,1%)=mid$(s1$,k%,1%)
  255.                                             end if
  256.                                         next k%
  257.                                     next j%
  258.                                     close 1
  259.                                     for j%=2% to 24%
  260.                                         call qprint(text$(j%),j%,1%)
  261.                                     next j%
  262.                                 end if
  263.                             end if
  264.                         end if
  265.  
  266. rem $subtitle:'Generate the BASIC code.'
  267. rem $page
  268.                         if menop%=5% then       ' Generate Basic
  269.                             dialog$(1)="BASIC program to create is ..."
  270.                             dialog$(2)=""
  271.                             fil.1$=string$(8%,32%)
  272.                             l1%=8%
  273.                             call Dialog(fil.1$,l1%)
  274.                             call ctrl.trim(fil.1$)
  275.                             open "o",1,fil.1$+".bas"
  276.                             dialog$(1%)="Title this program ..."
  277.                             dialog$(2%)=""
  278.                             call Dialog(tit$,50%)
  279.                             call ctrl.trim(tit$)
  280.                             print #1,"rem $linesize:132"
  281.                             print #1,"rem $title:'"+tit$+"'"
  282.                             print #1,"rem $subtitle:'(c) Copyright Roy Barrow 1986,1987.'"
  283.                             print #1,""
  284.                             print #1,"' Screen Generator Version: SGDEMO"
  285.                             print #1,"' This program ("+fil.1$+") created on: "+date$+", "+time$
  286.                             print #1,""
  287.                             print #1,"  call "+fil.1$+".frame"
  288.                             print #1,""
  289.                             print #1,"  END"
  290.                             print #1,""
  291.                             print #1,"  sub "+fil.1$+".frame static"
  292.                             for j%=2% to 24%
  293.                                 w$=text$(j%)
  294.                                 call trim(w$)
  295.                                 if len(w$) then
  296.                                     w%=instr(text$(j%),w$)
  297.                                     print #1,"        locate "+fnn$(j%)+","+fnn$(w%)
  298.                                     print #1,"        print "+chr$(34%)+w$+chr$(34%)+";"
  299.                                 end if
  300.                             next j%
  301.                             print #1,"  end sub ' "+fil.1$
  302.                             close 1
  303.                         end if
  304.  
  305. rem $subtitle:'Status / free memory.'
  306. rem $page
  307.                         if menop%=7% then       ' Show status
  308.                             dialog$(1%)="Free memory (before compaction) is"+str$(fre(0))
  309.                             dialog$(2%)="Free memory (after compaction) is"+str$(fre(""))
  310.                             dialog$(3%)="Size of next free LNA is"+str$(fre(-1))
  311.                             call Press.Any.Key(3%)
  312.                         end if
  313.  
  314.                     end if
  315.  
  316.                     if menu%=2% then
  317. rem $subtitle:'Copy above line'
  318. rem $page
  319.                         if menop%=1% then          ' Copy above line
  320.                             text$(y%)=text$(y%-1%)
  321.                             call qprint(text$(y%),y%,1%)
  322.                             y%=y%+1%
  323.                         end if
  324.  
  325. rem $subtitle:'Center the current line.'
  326. rem $page
  327.                         if menop%=2% then          ' Centre line
  328.                             call trim(text$(y%))
  329.                             text$(y%)=string$((80%-len(text$(y%)))/2%,32%)+text$(y%)
  330.                             text$(y%)=text$(y%)+string$(80%-len(text$(y%)),32%)
  331.                             call qprint(text$(y%),y%,1%)
  332.                         end if
  333. rem $subtitle:'Insert a blank line.'
  334. rem $page
  335.                         if menop%=3% then          ' Insert line
  336.                             for j%=24% to y%+1% step -1%
  337.                                 text$(j%)=text$(j%-1%)
  338.                             next j%
  339.                             text$(y%)=string$(80%,32%)
  340.                             for j%=24% to y% step -1%
  341.                                 call qprint(text$(j%),j%,1%)
  342.                             next j%
  343.                         end if
  344. rem $subtitle:'Delete current line and scroll others up'
  345. rem $page
  346.                         if menop%=4% then          ' Delete line
  347.                             for j%=y% to 23%
  348.                                 text$(j%)=text$(j%+1%)
  349.                             next j%
  350.                             text$(24%)=string$(80%,32%)
  351.                             for j%=y% to 24%
  352.                                 call qprint(text$(j%),j%,1%)
  353.                             next j%
  354.                         end if
  355. rem $subtitle:'Insert a column of blanks at this point'
  356. rem $page
  357.                         if menop%=5% then          ' Insert column
  358.                             ch%=32%                 ' Character to insert
  359.                             for j%=2% to 24%
  360.                                 if x%=1% then
  361.                                     text$(j%)=chr$(ch%)+mid$(text$(j%),1%,79%)
  362.                                 end if
  363.  
  364.                                 if x%=80% then
  365.                                     mid$(text$(j%),80%,1%)=chr$(ch%)
  366.                                 end if
  367.  
  368.                                 if (x%>1% and x%<80%) then
  369.                                     pref$=mid$(text$(j%),1%,x%-1%)
  370.                                     post$=mid$(text$(j%),x%,79%)
  371.                                     text$(j%)=pref$+chr$(ch%)+post$
  372.                                 end if
  373.  
  374.                                 if len(text$(j%))>80% then
  375.                                     text$(j%)=mid$(text$(j%),1%,80%)
  376.                                 end if
  377.  
  378.                                 call qprint(text$(j%),j%,1%)
  379.                             next j%
  380.                         end if
  381. rem $subtitle:'Delete a column at this point'
  382. rem $page
  383.                         if menop%=6% then             ' Delete column
  384.  
  385.                             for j%=2% to 24%
  386.  
  387.                                 if x%=1% then
  388.                                     text$(j%)=mid$(text$(j%),2%,80%)+" "
  389.                                 end if
  390.                                 if x%=80% then
  391.                                     mid$(text$(j%),80%,1%)=" "
  392.                                 end if
  393.                                 if (x%>1% and x%<80%) then
  394.                                     pref$=mid$(text$(j%),1%,x%-1)
  395.                                     post$=mid$(text$(j%),x%+1,79%)
  396.                                     text$(j%)=pref$+post$+" "
  397.                                 end if
  398.  
  399.                                 call qprint(text$(j%),j%,1%)
  400.                             next j%
  401.  
  402.                         end if
  403. rem $subtitle:'Find and replace text on whole screen'
  404. rem $page
  405.                         if menop%=7% then             ' Find & Replace
  406.                             dialog$(1)="Find..."
  407.                             dialog$(2)="and replace it with..."
  408.                             dialog$(3)="(If items differ in length, the"
  409.                             dialog$(4)="line will loose characters)"
  410.                             find$=string$(8%,32%)
  411.                             rep$=string$(8%,32%)
  412.                             l1%=8%
  413.                             l2%=8%
  414.                             call Dialog.Two(find$,l1%,rep$,l2%)
  415.                             call ctrl.trim(find$)
  416.                             call ctrl.trim(rep$)
  417.                             a%=len(find$)
  418.                             b%=len(rep$)
  419.                             if a%>b% then
  420.                                 b%=a%
  421.                             end if
  422.  
  423.                             if len(find$)<b% then
  424.                                 find$=find$+string$(b%-len(find$),32%)
  425.                             end if
  426.                             if len(rep$)<b% then
  427.                                 rep$=rep$+string$(b%-len(rep$),32%)
  428.                             end if
  429.                             for j%=2% to 24%
  430.                                 a%=instr(text$(j%),find$)
  431.                                 c%=0%
  432.                                 while a% and c%<80%
  433.                                     mid$(text$(j%),a%,b%)=rep$
  434.                                     c%=c%+1%
  435.                                     a%=instr(text$(j%),find$)
  436.                                 wend
  437.                                 call qprint(text$(j%),j%,1%)
  438.  
  439.                             next j%
  440.  
  441.                         end if
  442. rem $subtitle:'Clear (blank) the whole screen'
  443. rem $page
  444.                         if menop%=9% then             ' CLEAR
  445.                             for j%=2% to 24%
  446.                                 text$(j%)=string$(80%,32%)
  447.                                 call qprint(text$(j%),j%,1%)
  448.                             next j%
  449.                         end if
  450.  
  451.  
  452.                     end if
  453.  
  454.                     if menu%=3% then
  455. rem $subtitle:'Draw a box'
  456. rem $page
  457.                         if menop%=1% then             ' Draw a BOX
  458.                             dialog$(1)="To draw a box, move to the opposite"
  459.                             dialog$(2)="corner & press return - still continue?"
  460.                             call yes.no(yn$)
  461.                             if yn$="Y" then            ' Yes, a box has been chosen
  462.                                 bx.draw%=1%             ' Turn on box draw
  463.                                 dr.only%=1%             ' Make allowable input draw only
  464.                                 crx%=x%
  465.                                 cry%=y%
  466.                             end if
  467.                         end if
  468.  
  469. rem $subtitle:'Draw a vertical line'
  470. rem $page
  471.                         if menop%=2% then             ' Draw a Vertical line
  472.                             dialog$(1)="To draw a line, move to the opposite"
  473.                             dialog$(2)="end & press return - still continue?"
  474.                             call yes.no(yn$)
  475.                             if yn$="Y" then            ' Yes, a vertical line has been chosen
  476.                                 vl.draw%=1%             ' Turn on line draw
  477.                                 dr.only%=1%             ' Make allowable input draw only
  478.                                 crx%=x%
  479.                                 cry%=y%
  480.                             end if
  481.                         end if
  482.  
  483. rem $subtitle:'Draw a horizontal line'
  484. rem $page
  485.                         if menop%=3% then             ' Draw a horizontal line
  486.                             dialog$(1)="To draw a line, move to the opposite"
  487.                             dialog$(2)="end & press return - still continue?"
  488.                             call yes.no(yn$)
  489.                             if yn$="Y" then            ' Yes, a horizontal line been chosen
  490.                                 hz.draw%=1%             ' Turn on line draw
  491.                                 dr.only%=1%             ' Make allowable input draw only
  492.                                 crx%=x%
  493.                                 cry%=y%
  494.                             end if
  495.                         end if
  496.  
  497.                     end if
  498.  
  499.  
  500.                     if menu%=4% then
  501. rem $subtitle:'Define an input'
  502. rem $page
  503.  
  504.                             dialog$(1%)="This option is not available in"
  505.                             dialog$(2%)="the demo version of the screen"
  506.                             dialog$(3%)="generator. This is a function"
  507.                             dialog$(4%)="available ONLY in the Application"
  508.                             dialog$(5%)="Engineer Program Generator...."
  509.                             call Press.Any.Key(5%)
  510.  
  511.                     end if
  512.  
  513.                     if menu%=6% then
  514.                         where%=varptr(ae.screens%(1%))
  515.                         call scrsave(where%)
  516.                         cls
  517.                         call aecolins
  518.                         close
  519.                         call scrrest(where%)
  520.                         menop%=0%
  521.                         menu%=0%
  522.                     end if
  523.  
  524.                     if menu%=5% then
  525. rem $subtitle:'SHELL - return to DOS (Temporarily)'
  526. rem $page
  527.                         if menop%=2% then             ' SHELL
  528.                             where%=varptr(ae.screens%(1%))
  529.                             call scrsave(where%)
  530.                             cls
  531.                             print "Use EXIT to return to SGDEMO"
  532.                             shell "\COMMAND"           ' Call the command processor
  533.                             call scrrest(where%)
  534.                         end if
  535.  
  536. rem $subtitle:'Return to DOS'
  537. rem $page
  538.                         if menop%=3% then             ' System
  539.                             dialog$(1)="Ensure that you have SAVE'd your screen"
  540.                             dialog$(2)="Do you still want to EXIT SGDEMO ?"
  541.                             call Yes.No(yn$)
  542.                             if yn$="Y" then
  543.                                 cls
  544.                                 print "SGDEMO returning to DOS"
  545.                                 system
  546.                             end if
  547.                         end if
  548.                     end if
  549.                 end if
  550.             end if
  551.         end if
  552.  
  553.         if ctype%=2% then
  554. rem $subtitle:'General Editing Keys including delete'
  555. rem $page
  556.             if dr.only%=0% then
  557.                 if ch%=82% then                      ' Insert on / off
  558.                     if ins$="Off" then
  559.                         ins$="On "
  560.                     else
  561.                         ins$="Off"
  562.                     end if
  563.                 end if
  564.  
  565.  
  566.                 if ch%=83% then                       ' Delete
  567.                     if x%=1% then
  568.                         text$(y%)=mid$(text$(y%),2%,80%)+" "
  569.                     end if
  570.                     if x%=80% then
  571.                         mid$(text$(y%),80%,1%)=" "
  572.                     end if
  573.  
  574.                     if (x%>1% and x%<80%) then
  575.                         pref$=mid$(text$(y%),1%,x%-1)
  576.                         post$=mid$(text$(y%),x%+1,79%)
  577.                         text$(y%)=pref$+post$+" "
  578.                     end if
  579.  
  580.                     call qprint(text$(y%),y%,1%)
  581.                 end if
  582.             end if
  583.  
  584.             if dr.only%=0% or (hz.draw%=1% or bx.draw%=1%) then
  585.                 if ch%=75%  then                 ' Left Arrow
  586.                     x%=x%-1%
  587.                 end if
  588.  
  589.                 if ch%=77% then                  ' Right Arrow
  590.                     x%=x%+1%
  591.                 end if
  592.             end if
  593.  
  594.  
  595.             if dr.only%=0% or (vl.draw%=1% or bx.draw%=1%) then
  596.                 if ch%=72% then                  ' Up Arrow
  597.                     y%=y%-1%
  598.                 end if
  599.  
  600.                 if ch%=80% then                  ' Down Arrow
  601.                     y%=y%+1%
  602.                 end if
  603.             end if
  604.         end if
  605.  
  606.         if ctype%=1% then
  607.  
  608.             if ch%=13% then
  609.                 if dr.only%=0% then
  610.                     x%=1%
  611.                     y%=y%+1%
  612.                 end if
  613.                 if crx%>x% then
  614.                     stx%=x%
  615.                     enx%=crx%
  616.                 else
  617.                     stx%=crx%
  618.                     enx%=x%
  619.                 end if
  620.                 if cry%>y% then
  621.                     sty%=y%
  622.                     eny%=cry%
  623.                 else
  624.                     sty%=cry%
  625.                     eny%=y%
  626.                 end if
  627.                 if dr.only%=1% then
  628.                     if hz.draw%=1% then           ' Complete horizontal line
  629.                         fl$(1%)=string$(5%,196%)
  630.                         fl$(2%)=string$(5%,205%)
  631.                         fl$(3%)=string$(5%,"-")
  632.                         fl$(4%)=string$(5%,"_")
  633.                         fl$(5%)=string$(5%,"=")
  634.                         dialog$(1)="Select a line"
  635.                         dialog$(2)="type from those"
  636.                         dialog$(3)="available in the"
  637.                         dialog$(4)="list displayed"
  638.                         call select.box(fl$(),4%,5%,5%,opt$)
  639.                         if len(opt$)<>0% then
  640.                             for hz.draw%=stx% to enx%
  641.                                 mid$(text$(y%),hz.draw%,1%)=chr$(asc(opt$))
  642.                             next hz.draw%
  643.                             call qprint(text$(y%),y%,1%)
  644.                         end if
  645.                     hz.draw%=0%
  646.                     end if
  647.  
  648.                     if vl.draw%=1% then           ' Complete vertical line
  649.                         fl$(1%)=chr$(179%)
  650.                         fl$(2%)=chr$(186%)
  651.                         fl$(3%)="|"
  652.                         fl$(4%)="!"
  653.                         dialog$(1)="Select a line"
  654.                         dialog$(2)="type from those"
  655.                         dialog$(3)="available in the"
  656.                         dialog$(4)="list displayed"
  657.                         call select.box(fl$(),4%,4%,2%,opt$)
  658.                         if len(opt$)<>0% then
  659.                             for vl.draw%=sty% to eny%
  660.                                 mid$(text$(vl.draw%),x%,1%)=chr$(asc(opt$))
  661.                                 call qprint(text$(vl.draw%),vl.draw%,1%)
  662.                             next vl.draw%
  663.                         end if
  664.                         vl.draw%=0%
  665.                     end if
  666.                     if bx.draw%=1% then           ' Complete box
  667.                         fl$(1%)=chr$(218%)+chr$(196%)+chr$(191%)
  668.                         fl$(2%)=chr$(213%)+chr$(205%)+chr$(184%)
  669.                         fl$(3%)=chr$(214%)+chr$(196%)+chr$(183%)
  670.                         fl$(4%)=chr$(201%)+chr$(205%)+chr$(187%)
  671.                         dialog$(1)="Select a Box line"
  672.                         dialog$(2)="type from those"
  673.                         dialog$(3)="available in the"
  674.                         dialog$(4)="list displayed"
  675.                         call select.box(fl$(),4%,4%,3%,opt$)
  676.                         if len(opt$)<>0% then
  677.                             box.t%=asc(opt$)
  678.                             if box.t%=218% then
  679.                                 tl%=218%
  680.                                 tr%=191%
  681.                                 bl%=192%
  682.                                 br%=217%
  683.                                 vt%=179%
  684.                                 hz%=196%
  685.                             end if
  686.                             if box.t%=213% then
  687.                                 tl%=213%
  688.                                 tr%=184%
  689.                                 bl%=212%
  690.                                 br%=190%
  691.                                 vt%=179%
  692.                                 hz%=205%
  693.                             end if
  694.                             if box.t%=201% then
  695.                                 tl%=201%
  696.                                 tr%=187%
  697.                                 bl%=200%
  698.                                 br%=188%
  699.                                 vt%=186%
  700.                                 hz%=205%
  701.                             end if
  702.                             if box.t%=214% then
  703.                                 tl%=214%
  704.                                 tr%=183%
  705.                                 bl%=211%
  706.                                 br%=189%
  707.                                 vt%=186%
  708.                                 hz%=196%
  709.                             end if
  710.                             for bx%=stx%+1% to enx%-1%
  711.                                 mid$(text$(sty%),bx%,1%)=chr$(hz%)
  712.                                 mid$(text$(eny%),bx%,1%)=chr$(hz%)
  713.                             next bx%
  714.                             for bx%=sty%+1% to eny%-1%
  715.                                 mid$(text$(bx%),stx%,1%)=chr$(vt%)
  716.                                 mid$(text$(bx%),enx%,1%)=chr$(vt%)
  717.                             next bx%
  718.                             mid$(text$(sty%),stx%,1%)=chr$(tl%)
  719.                             mid$(text$(eny%),stx%,1%)=chr$(bl%)
  720.                             mid$(text$(sty%),enx%,1%)=chr$(tr%)
  721.                             mid$(text$(eny%),enx%,1%)=chr$(br%)
  722.                             for bx%=sty% to eny%
  723.                                 call qprint(text$(bx%),bx%,1%)
  724.                             next bx%
  725.                         end if
  726.                         bx.draw%=0%
  727.                     end if
  728.                     dr.only%=0%
  729.                 end if
  730.             end if
  731.  
  732.  
  733.             if dr.only%=0% then
  734.                 if ch%=8% then
  735.                     mid$(text$(y%),x%,1%)=chr$(32%)
  736.                     call qprint(text$(y%),y%,1%)
  737.                     x%=x%-1%
  738.                 end if
  739.  
  740.                 if ch%=127% then
  741.                     if x%=1% then
  742.                         text$(y%)=mid$(text$(y%),2%,80%)+" "
  743.                     end if
  744.                     if x%=80% then
  745.                         mid$(text$(y%),80%,1%)=" "
  746.                     end if
  747.  
  748.                     if (x%>1% and x%<80%) then
  749.                         pref$=mid$(text$(y%),1%,x%-1)
  750.                         post$=mid$(text$(y%),x%+1,79%)
  751.                         text$(y%)=pref$+post$+" "
  752.                     end if
  753.  
  754.                     call qprint(text$(y%),y%,1%)
  755.                 end if
  756.  
  757.                 if ch%=9% then
  758.                     x%=x%+5%
  759.                 end if
  760.  
  761.                 if (ch%>31% and ch%<127%) or (ch%>173% and ch%<254%) then
  762.  
  763.                     if ins$="Off" then
  764.                         mid$(text$(y%),x%,1%)=chr$(ch%)
  765.                     end if
  766.  
  767.                     if ins$="On " then
  768.  
  769.                         if x%=1% then
  770.                             text$(y%)=chr$(ch%)+mid$(text$(y%),1%,79%)
  771.                         end if
  772.  
  773.                         if x%=80% then
  774.                             mid$(text$(y%),80%,1%)=chr$(ch%)
  775.                         end if
  776.  
  777.                         if (x%>1% and x%<80%) then
  778.                             pref$=mid$(text$(y%),1%,x%-1%)
  779.                             post$=mid$(text$(y%),x%,79%)
  780.                             text$(y%)=pref$+chr$(ch%)+post$
  781.                         end if
  782.  
  783.                         if len(text$(y%))>80% then
  784.                             text$(y%)=mid$(text$(y%),1%,80%)
  785.                         end if
  786.  
  787.                     end if
  788.                     x%=x%+1%
  789.                     call qprint(text$(y%),y%,1%)
  790.                 end if
  791.             end if
  792.         end if
  793.  
  794.         if y%>ymax% then
  795.             y%=ymin%
  796.         end if
  797.  
  798.         if y%<ymin% then
  799.             y%=ymax%
  800.         end if
  801.  
  802.         if x%>xmax% then
  803.             x%=xmin%
  804.         end if
  805.  
  806.         if x%<xmin% then
  807.             x%=xmax%
  808.         end if
  809.  
  810.     wend
  811.  
  812.  
  813.     end
  814.  
  815. rem $subtitle:'Read menu definitions from DATA statements'
  816. rem $page
  817. get.menu:
  818.     e.count%=0%
  819.     read mcount%
  820.     for mop%=1% to mcount%
  821.         e.count%=e.count%+1%
  822.         read ae.menu$(e.count%)
  823.     next mop%
  824.     for mop%=1% to mcount%
  825.         read sop%
  826.         for j%=1% to sop%
  827.             e.count%=e.count%+1%
  828.             read ae.menu$(e.count%)
  829.         next j%
  830.         ae.op%(mop%)=sop%
  831.     next mop%
  832.     return
  833.  
  834. rem $subtitle:'Startup screen - greetings'
  835.  
  836.         sub startup static
  837.  
  838.             call explode
  839.             call SG5greet
  840.             call Get.Single(a%,b%)
  841.  
  842.         end sub
  843.  
  844.         sub explode static
  845.             tr$="╗"
  846.             bl$="╚"
  847.             br$="╝"
  848.             horz$="═"
  849.             vert$="║"
  850.  
  851.             c%=11%   ' Center point
  852.             b%=25%
  853.             for d%=2% to 7%
  854.                 call qprint("╔",c%-d%,b%)
  855.                 call qprint(tr$,c%-d%,80%-b%)
  856.                 call qprint(bl$,c%+d%,b%)
  857.                 call qprint(br$,c%+d%,80%-b%)
  858.                 call qprint(string$((39%-b%)*2%+1%,horz$),c%-d%,b%+1%)
  859.                 call qprint(string$((39%-b%)*2%+1%,horz$),c%+d%,b%+1%)
  860.                 for j%=(c%-d%)+1% to (c%+d%)-1%
  861.                     call qprint(vert$,j%,b%)
  862.                     call qprint(vert$,j%,80%-b%)
  863.                 next j%
  864.  
  865.                 if d%<>7% then
  866.  
  867.                     call qprint(" ",c%-d%,b%)
  868.                     call qprint(" ",c%-d%,80%-b%)
  869.                     call qprint(" ",c%+d%,b%)
  870.                     call qprint(" ",c%+d%,80%-b%)
  871.                     call qprint(string$((39%-b%)*2%+1%,32),c%-d%,b%+1%)
  872.                     call qprint(string$((39%-b%)*2%+1%,32),c%+d%,b%+1%)
  873.  
  874.                     for j%=(c%-d%)+1% to (c%+d%)-1%
  875.                         call qprint(" ",j%,b%)
  876.                         call qprint(" ",j%,80%-b%)
  877.                     next j%
  878.  
  879.                     b%=b%-2%
  880.                 end if
  881.             next d%
  882.  
  883.  
  884.     end sub
  885.  
  886.       sub SG5greet static
  887.           call qprint("Screen Generator Utility",9,29)
  888.           call qprint("(C) Roy Barrow 1986,1987",10,29)
  889.           call qprint("Version SGDEMO",11,34)
  890.           call qprint("Press any Key to continue",13,29)
  891.           end sub
  892.  
  893.  
  894.   sub QBTOOLS.frame static
  895.        call qprint("╒═══════════════════════════════════════════════════Press any key to continue══╕",2,1)
  896.        call qprint("│                                                                              │",3,1)
  897.        call qprint("│   QuickBASIC Toolbox, by Roy Barrow                                          │",4,1)
  898.        call qprint("│                                                                              │",5,1)
  899.        call qprint("│   The QuickBASIC Toolbox is a collection of sub programs that can be         │",6,1)
  900.        call qprint("│   included with your QuickBASIC applications. A few of the functions         │",7,1)
  901.        call qprint("│   of this collection are demonstrated in this program, a simple basic        │",8,1)
  902.        call qprint("│   screen generator.                                                          │",9,1)
  903.        call qprint("│                                                                              │",10,1)
  904.        call qprint("│   Other functions not displayed here include:                                │",11,1)
  905.        call qprint("│                                                                              │",12,1)
  906.        call qprint("│   Binary Tree File Indexing ,  Dynamic File Control ,                        │",13,1)
  907.        call qprint("│   Text Block, Numeric & Date Input with range validation ,                   │",14,1)
  908.        call qprint("│   Context Sensitive Help .... and a host more.                               │",15,1)
  909.        call qprint("│                                                                              │",16,1)
  910.        call qprint("│   A copy of these routines and source code is available for $30 from:        │",17,1)
  911.        call qprint("│                                                                              │",18,1)
  912.          call qprint("│   Roy Barrow                    BBBS - Wildcat!                              │",19,1)
  913.          call qprint("│   5g 222 Church Street  - or -  Basic programmers Bulletin Board System      │",20,1)
  914.          call qprint("│   Philadelphia                  (215) 627-3910  24hrs 2400/1200 Baud         │",21,1)
  915.          call qprint("│   PA 19106                                                                   │",22,1)
  916.        call qprint("│   (215) 922-2557 ..... Ask about the Application Engineer Program Generator. │",23,1)
  917.        call qprint("╘══════════════════════════════════════════════════════════════════════════════╛",24,1)
  918.   end sub ' QBTOOLS
  919.